home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops source / Asm Source / Getop < prev    next >
Text File  |  1992-09-13  |  5KB  |  246 lines
  1. \ The Dreaded GetOp - builds the operand structure
  2.  
  3. 0 -> dlevel
  4.  
  5. \ 0 value  OPPTR        Changed to an ObjPtr - in AsmUtilities
  6.  
  7.     0    value    TOKEN_TYPE
  8.  
  9.     objPtr    OPDESC    class_is operand
  10.  
  11.  
  12. : (FORMAT)  { addr len -- fmt }        \ Finds operand format
  13.         addr c@
  14.     CASE    & B    OF    Bfmt    ENDOF
  15.         & W    OF    Wfmt    ENDOF
  16.         & L    OF    Lfmt    ENDOF
  17.         & S    OF    Sfmt    ENDOF
  18.         & D    OF    Dfmt    ENDOF
  19.         & X    OF    Xfmt    ENDOF
  20.            & P    OF    Pfmt    ENDOF
  21.  
  22.            202 AsmError        \ Bad operand format
  23.     ENDCASE  ;
  24.  
  25.  
  26. : NEXTOPERAND
  27.     nextToken -> token_type
  28.     " ," get: token s=
  29.     IF
  30.         nextToken -> token_type
  31.     THEN  ;
  32.  
  33.  
  34. : GETFORMAT
  35.     restOfLine  nif  drop  exit  then    \ Out if line empty
  36.     c@  & .  <> ?EXIT            \ Or if we don't have a format code
  37.     nextToken drop                \ Gobble "."
  38.     nextToken drop                \ Get format code
  39.     get: token  (format) -> opFmt  ;
  40.  
  41.  
  42. : CLEAROP  { opPtr -- }
  43.     0 opPtr seta/d: operand
  44.     0 opPtr setauxsize: operand
  45.     0 opPtr setReg: operand
  46.     0 opPtr setval: operand
  47.     0 opPtr setmode: operand
  48.     0 opPtr setauxreg: operand
  49.     0 opPtr setpcmode: operand  ;
  50.  
  51.  
  52. : ABSMODE
  53.     msg" absolute mode"
  54.     7 setMode: opPtr
  55.     get: token  " ."  s=
  56.     IF   ( Length explicitly specified )
  57.         nextToken drop
  58.         get: token  (format) 1- 0 max
  59.     ELSE ( Supply length here )
  60.         value: opPtr
  61.         -32768  $ 7FFF inRange? 1+    \ 0 word, 1 long
  62.     THEN
  63.     dup setReg: opPtr  7 +  setpcmode: opPtr  ;
  64.  
  65. : HANDLE_INDEX
  66.     msg" index mode"
  67.     nextToken drop        \ should be comma
  68.         nextToken drop token query: operands drop -> opDesc
  69.     mode: opDesc  dup 20 =  swap 21 =  or
  70.     IF            \ No len associated with index reg
  71.         reg: opDesc  setAuxReg: opPtr
  72.         mode: opDesc  20 - val" a/d to"  setA/D: opPtr
  73.         2 setAuxSize: opPtr    \ Default for Mops is long
  74.     ELSE
  75.         nextToken 3 =    \ should be '.', len associated
  76.                 \  with index reg
  77.         IF
  78.             reg: opDesc  setAuxReg: opPtr
  79.             mode: opDesc  setA/D: opPtr
  80.             nextToken drop get: token (format)
  81.             setAuxSize: opPtr
  82.         ELSE
  83.             203 asmError    \ unknown operand
  84.         THEN
  85.     THEN  ;
  86.  
  87. : AnREL+
  88.     -1 setAbs: opPtr        \ This wasn't a dic ref
  89.     ( mode: opDesc )  dup  setpcmode: opPtr
  90.     7 min val" setMode to" setMode: opPtr
  91.     mode: opPtr  2 =
  92.     IF  5 setMode: opPtr  THEN
  93.     reg: opDesc  val" setReg to"  setReg: opPtr
  94.     mode: opDesc  dup 6 =  swap 10 =  or
  95.     IF  handle_index  THEN  ;
  96.  
  97.  
  98. : GETDICTTOKEN    \ Parses a dictionary name (which can contain all sorts
  99.         \ of strange characters).  Following the Neon syntax, we
  100.         \ take it as anything up to the next ].
  101.         \ Sorry, this means that you can't refer to a dic name
  102.         \ containing ] from the assembler.  I think space would
  103.         \ have been better, but then this may well have caused
  104.         \ other problems.
  105.     tib pos +  tiblen pos -  put: token
  106.     & ]  chsearch: token  drop
  107.     tiblen
  108.     size: token  lim: token  -  ( # chars left )
  109.     -  -> pos  ;
  110.  
  111.  
  112. : GETDICTPTR    \ ( -- addr )  "Dic" read.  Returns dic address.
  113.     getDictToken
  114.     get: token  2dup upper  str255  find
  115.     IF
  116.         val" dic addr"
  117.     ELSE
  118.         216 asmError
  119.     THEN
  120.     nextToken drop  ;    \ "]"
  121.  
  122.  
  123. : GETGLOB    \ ( -- addr )  " Glob[" read.  Returns global address.
  124.     getDictToken
  125.     get: token  2dup upper
  126.     $>glob
  127.     nextToken drop  ;    \ "]"
  128.  
  129. : GETKONST    \ ( -- kval )  " konst[" read.  Returns the value.
  130.     getDictToken
  131.     get: token  2dup upper
  132.     $>konst
  133.     nextToken drop  ;    \ "]"
  134.  
  135. : COMPBD
  136.     abs: opPtr
  137.     >b&dComp            \ convert to ( base displ )
  138.     setval: opPtr            \ set displ
  139.     setReg: opPtr            \ set base reg
  140.     AnRelMode setmode: opPtr  ;    \ mode = d(An)
  141.  
  142.  
  143. : DICREF    \ "dic", "glob" etc. read
  144.     msg" dic reference"
  145.     nextToken drop            \ Should be "[" - we'll check
  146.     get: token 1 <>    IF  217 asmerror  THEN
  147.     c@  & [  <>    IF  217 asmerror  THEN
  148.     opDesc reg: operand
  149.     SELECT{
  150.         3 IS{    getGlob        }END
  151.         4 IS{    getKonst    }END
  152.         DEFAULT{
  153.             getDictPtr            \ get dic addr
  154.             opDesc reg: operand  2 =    \ If an object ref,
  155.             IF  >obj  THEN            \  adjust address
  156.     }SELECT
  157.     value: opPtr  +            \ add any displacement
  158.     dup  setAbs: opPtr
  159.          setVal: opPtr
  160.     opDesc reg: operand
  161.     SELECT{
  162.         0 IS{                \ rel[...]
  163.             9 setMode: opPtr    \  set PC-relative mode
  164.             2 setReg: opPtr        }END
  165.         3 IS{                \ glob[...]
  166.             7 setMode: opPtr    \  set absolute mode
  167.             0 setReg: opPtr        }END
  168.         4 IS{                \ konst[...]
  169.             11 setMode: opPtr    \  set immediate mode
  170.              4 setReg: opPtr    }END
  171.         DEFAULT{  compBD
  172.     }SELECT  ;
  173.  
  174.  
  175. : HANDLE_LABEL
  176.     msg" handling label"
  177.     pass 2 =
  178.     IF
  179.         token  query: symTab
  180.         dup nilP =
  181.         IF
  182.             251 asmError        \ Undef. label
  183.         ELSE
  184.             get: var
  185.             value: opPtr +        \ Add any displacement
  186.             dup  setAbs: opPtr  setVal: opPtr
  187.         THEN
  188.     THEN
  189.     compBD  ;
  190.  
  191.  
  192. : LABDISP    \ Handles disp(label).
  193.     1 skip: token  -1 more: token  handle_label
  194.     nextToken drop  ;
  195.  
  196.  
  197. : HANDLE_#
  198.     msg" number read"
  199.     get: token  >num  val" number is"
  200.     setVal: opPtr
  201.     nextToken drop
  202.     token  query: operands
  203.     NIF
  204.         1st: token  & (  =
  205.         IF  labDisp  ELSE  absMode  THEN
  206.         EXIT
  207.     THEN
  208.     -> opDesc
  209.     opDesc mode: operand  val" mode is "
  210.     dup  (An)Mode =  over IndexMode = or
  211.     over PCrelMode = or  over PCindexMode = or
  212.     IF  AnRel+  EXIT  THEN
  213.     ( mode: opDesc )  DicMode =
  214.     IF  ( nnn(dic[ )
  215.         dicRef
  216.         nextToken drop        \ Gobble ")"
  217.         EXIT
  218.     THEN
  219.     203 AsmError  ;
  220.  
  221.  
  222. : HANDLE_IMM
  223.      nextToken  1 =
  224.     IF
  225.         get: token >num  setVal: opPtr
  226.     ELSE
  227.         205 asmError
  228.     THEN  ;
  229.  
  230.  
  231. : HANDLE_NAME
  232.         token query: operands
  233.     val" F means Label"  NIF  handle_label  EXIT  THEN
  234.     -> opDesc
  235.     reg: opDesc    val" reg is "  setReg: opPtr
  236.     mode: opDesc    val" mode is "  setMode: opPtr
  237.     mode: opPtr immedMode = IF  handle_imm  EXIT  THEN
  238.     mode: opPtr  dicMode =
  239.     IF  dicRef  THEN  ;
  240.  
  241.  
  242. : GETOP
  243.     -> opPtr
  244.     opptr clearOp  nextOperand
  245.     token_type  1 = IF  handle_#  ELSE  handle_name  THEN  ;
  246.